Covid19 Japan

Covid19 Japanが独自に収集している陽性者単位のデータ(個票データ)。ソースとデータは全てGitHubにて公開されており、データはJSON形式。「レコード数 \(\neq\) 累計陽性者数」であることに注意。

 

Import

Covid19 JapanGitHubで公開しているデータは前述のようにJSON形式であり、最新データはlatest.jsonファイルで示されている。このため、読み込む際はひと工夫必要。

Patient Data

陽性者単位の個票データ。

path <- "https://raw.githubusercontent.com/reustle/covid19japan-data/master/docs/patient_data/"

df <- path %>% 
  paste0("latest.json") %>% 
  readr::read_lines() %>% 
  paste0(path, .) %>% 
  jsonlite::fromJSON()

df

Summary Data 【参考】

死亡者数や重症者数などの推移データはsummaryフォルダ内のJSON形式ファイルにまとめられている。summaryフォルダの他にsummary_minフォルダというフォルダがあるが、summary_minフォルダ内のJSONファイルは単に改行を省略して小さくしたファイル。

path <- "https://raw.githubusercontent.com/reustle/covid19japan-data/master/docs/summary/"

df_s <- path %>% 
  paste0("latest.json") %>% 
  readr::read_lines() %>% 
  paste0(path, .) %>% 
  jsonlite::fromJSON()

df_s %>% summary()
##             Length Class      Mode     
## prefectures 27     data.frame list     
## regions     12     data.frame list     
## daily       37     data.frame list     
## updated      1     -none-     character

 
要約すると分かるように3つのデータフレーム(都道府県単位、八地方区分単位、日次)と一つのベクトル(更新日時)から構成されている。

 

都道府県単位集計

更新日次時点における都道府県単位での累積値。陽性者・死亡者などの時系列集計データはネストで格納されている。
厚生労働省のオープンデータが集計から除いている空港検疫・ダイヤモンドプリンセス・長崎クルーズ船・その他を含めて全51区分。

df_s$prefectures

 

地方単位集計

更新日次時点における八地方区分単位での累積値。陽性者・死亡者などの時系列集計データは都道府県単位と同様にネストで格納されている。
ただし、確認した時点(2020/11/3)では、時系列集計値の合計と累積値が一致しない。

df_s$regions

 

日次集計

個票データを日次で集計したもの。累積値の他に移動平均も含まれているが、暗黙の欠落を含んだデータである点に注意が必要。

df_s$daily

 

更新日時

の更新日時が記録されている。

df_s$updated
## [1] "2020-11-05T21:31:59+09:00"

 

Area Data

Covid19 Japanのデータは個票データなので、様々な属性が含まれている。これらの属性を利用して地域・地方ごとの分析を行う場合に便利な都道府県データを用意した。このデータはGistで公開している。

 

Others

その他のオープンデータ

新型コロナウイルス対策病床オープンデータ

 

Data Wrangling (tidy and transform)

Summarize

最初にデータがどのようになっているか確認する。これには要約に便利なskimrパッケージを用いる。

df %>% 
  skimr::skim()
Data summary
Name Piped data
Number of rows 106644
Number of columns 23
_______________________
Column type frequency:
character 19
logical 3
numeric 1
________________________
Group variables None

Variable type: character

skim_variable n_missing complete_rate min max empty n_unique whitespace
patientId 0 1.00 1 8 0 104965 0
dateAnnounced 0 1.00 10 10 0 282 0
gender 16441 0.85 1 1 0 2 0
detectedPrefecture 0 1.00 3 15 0 49 0
patientStatus 102669 0.04 8 23 0 8 0
notes 55281 0.48 1 270 0 48601 1
mhlwPatientNumber 106195 0.00 1 11 0 434 0
prefecturePatientNumber 14179 0.87 5 20 0 92456 0
prefectureSourceURL 75340 0.29 5 224 0 3439 0
residence 24377 0.77 1 38 0 1422 0
sourceURL 637 0.99 1 239 0 8055 0
relatedPatients 96248 0.10 2 259 0 6345 0
knownCluster 104162 0.02 3 88 0 229 0
detectedCityTown 80645 0.24 2 22 0 663 0
cityPrefectureNumber 80910 0.24 1 34 0 25725 2
citySourceURL 94812 0.11 9 317 0 3637 0
deceasedDate 104828 0.02 10 10 0 232 0
deceasedReportedDate 105430 0.01 10 62 0 204 0
deathSourceURL 105574 0.01 14 123 0 651 0

Variable type: logical

skim_variable n_missing complete_rate mean count
confirmedPatient 0 1 0.98 TRU: 104964, FAL: 1680
charterFlightPassenger 106630 0 1.00 TRU: 14
cruisePassengerDisembarked 106633 0 1.00 TRU: 11

Variable type: numeric

skim_variable n_missing complete_rate mean sd p0 p25 p50 p75 p100 hist
ageBracket 0 1 31.95 23.8 -1 20 30 50 100 ▅▇▅▂▁

 
元がJSON形式なので、読み込んだ直後は殆どの変量(フィーチャー)が文字型になっていることが分かる。また、意外と欠損が多いことも分かる。

 

Transform

各変量(フィーチャー)を適切な形式に変換し、地域区分でも分析できるように都道府県データと結合する。

x <- df %>% 
  dplyr::select(patientId, date = dateAnnounced, gender,
                pref = detectedPrefecture, patientStatus, knownCluster,
                confirmedPatient, charterFlightPassenger,
                cruisePassengerDisembarked, ageBracket,
                deceasedDate, deceasedReportedDate) %>% 
  dplyr::filter(confirmedPatient == TRUE) %>% 
  dplyr::mutate(date = lubridate::as_date(date),
                gender = forcats::as_factor(gender),
                patientStatus = forcats::as_factor(patientStatus),
                cluster = dplyr::if_else(!is.na(knownCluster), TRUE, FALSE),
                ageBracket = forcats::as_factor(ageBracket),
                deceasedDate = lubridate::as_date(deceasedDate),
                deceasedReportedDate = lubridate::as_date(deceasedReportedDate)) %>% 
  dplyr::left_join(prefs, by = c("pref" = "pref")) %>% 
  dplyr::select(-`推計人口`) %>% 
  dplyr::rename(Pref = `都道府県`, region = `八地方区分`)

x

変換結果を要約してみると

x %>% 
  skimr::skim()
Data summary
Name Piped data
Number of rows 104964
Number of columns 19
_______________________
Column type frequency:
character 3
Date 3
factor 9
logical 4
________________________
Group variables None

Variable type: character

skim_variable n_missing complete_rate min max empty n_unique whitespace
patientId 0 1.00 1 8 0 104964 0
pref 0 1.00 3 15 0 49 0
knownCluster 102511 0.02 3 88 0 227 0

Variable type: Date

skim_variable n_missing complete_rate min max median n_unique
date 0 1 2020-01-15 2020-11-05 2020-08-14 282
deceasedDate 104585 0 2020-02-13 2020-10-17 2020-05-08 150
deceasedReportedDate 104634 0 2020-02-13 2020-10-17 2020-05-16 131

Variable type: factor

skim_variable n_missing complete_rate ordered n_unique top_counts
gender 15784 0.85 FALSE 2 M: 50096, F: 39084
patientStatus 102431 0.02 FALSE 8 Hos: 1261, Dec: 371, Hom: 315, Dis: 283
ageBracket 0 1.00 FALSE 13 20: 24545, -1: 15883, 30: 15478, 40: 12799
pcode 1224 0.99 FALSE 47 13: 31923, 27: 13316, 14: 9034, 23: 6543
Pref 1224 0.99 FALSE 47 東京都: 31923, 大阪府: 13316, 神奈川: 9034, 愛知県: 6543
region 1224 0.99 FALSE 8 関東地: 54381, 近畿地: 20955, 九州地: 11065, 中部地: 10198
広域圏 8217 0.92 FALSE 8 首都圏: 54606, 近畿圏: 20381, 中部圏: 8866, 九州圏: 7627
通俗的区分 1224 0.99 FALSE 11 関東: 54381, 関西: 20381, 東海: 8517, 九州: 7627
fct_pref 1224 0.99 FALSE 47 Tok: 31923, Osa: 13316, Kan: 9034, Aic: 6543

Variable type: logical

skim_variable n_missing complete_rate mean count
confirmedPatient 0 1 1.00 TRU: 104964
charterFlightPassenger 104950 0 1.00 TRU: 14
cruisePassengerDisembarked 104953 0 1.00 TRU: 11
cluster 0 1 0.02 FAL: 102511, TRU: 2453

 
文字型を因子型に変換するだけでも大まかな傾向が見えるようになる。例えば

  • 年齢別で見ると20代、30代、年齢不明(恐らく非回答)、40代の順に多い
  • 都道府県別では東京、大阪、神奈川、愛知の順と人口にほぼ比例
  • 地方区分で見ると関東、近畿、九州、中部となっており九州地方が以外と多い

ことが読める。

patientStatusは以下の通りで、ほぼ更新されていないのと思われる。死者数などの推移を見る場合はサマリデータを使った方がいい。

x %>% 
  dplyr::group_by(patientStatus) %>% 
  dplyr::summarise(n = n()) %>% 
  dplyr::ungroup() %>% 
  dplyr::mutate(Japanese = c("回復", "入院中", "退院済", "死亡", "詳細不明",
                             "重症", "自宅療養", "ホテル療養", NA))

 

Data Wrangling (tidy and transform)

集計(陽性者)

地方別集計

地方区分で比較すると都道府県と同様に人口の多い関東、近畿はともかく、九州、北海道の陽性者率が高いことが分かる。

region <- prefs %>% 
  dplyr::group_by(`八地方区分`) %>% 
  dplyr::summarise(population = sum(`推計人口`)) %>% 
  dplyr::rename(region = `八地方区分`)

x %>% 
  dplyr::group_by(region) %>% 
  dplyr::summarise(n = n()) %>% 
  dplyr::left_join(region, by = c("region" = "region")) %>% 
  dplyr::select(region, n, population) %>% 
  dplyr::mutate(rate = round(n / population, 2))

 

 

都道府県別集計

都道府県別の総陽性者数と人口千人あたりの陽性者率。

x %>% 
  dplyr::group_by(Pref) %>% 
  dplyr::summarise(n = n()) %>% 
  dplyr::left_join(prefs, by = c("Pref" = "都道府県")) %>% 
  dplyr::select(Pref, n, population = `推計人口`) %>% 
  dplyr::mutate(rate = round(n / population, 2))

上位10県を累計人数と人口千人あたりの陽性者数で比べてみる。

x %>% 
  dplyr::group_by(Pref) %>% 
  dplyr::summarise(n = n()) %>% 
  dplyr::left_join(prefs, by = c("Pref" = "都道府県")) %>% 
  dplyr::select(Pref, n, population = `推計人口`) %>% 
  dplyr::mutate(rate = round(n / population, 2)) %>% 
  dplyr::slice_max(order_by = n, n = 10) %>% 
  dplyr::rename(`累計陽性者数` = n, `推計人口[千人]` = population, `率` = rate)
x %>% 
  dplyr::group_by(Pref) %>% 
  dplyr::summarise(n = n()) %>% 
  dplyr::left_join(prefs, by = c("Pref" = "都道府県")) %>% 
  dplyr::select(Pref, n, population = `推計人口`) %>% 
  dplyr::mutate(rate = round(n / population, 2)) %>% 
  dplyr::slice_max(order_by = rate, n = 10) %>% 
  dplyr::rename(`累計陽性者数` = n, `推計人口[千人]` = population, `率` = rate)

累計の陽性者数は、ほぼ、人口に比例しているが、一部の県での感染率が高いことが分かる。

 

日次集計(陽性者)

全国日次集計

陽性者数、前日、累計、移動平均。

x_by_all <- x %>% 
  dplyr::group_by(date) %>% 
  dplyr::filter(!is.na(Pref)) %>% 
  dplyr::summarise(n = n()) %>% 
  tidyr::complete(date = seq.Date(from = min(date), to = max(date), by = "day"),
                  fill = list(n = 0L)) %>% 
  dplyr::mutate(diff = lagdiff(n), cum = cumsum(n),
                ma7 = zoo::rollmeanr(n, k = 7L, na.pad = TRUE))

x_by_all

 

地方区分別日次集計

x_by_region <- x %>% 
  dplyr::filter(!is.na(Pref)) %>% 
  dplyr::group_by(date, region) %>% 
  dplyr::summarise(n = n()) %>% 
  dplyr::ungroup() %>% 
  tidyr::pivot_wider(names_from = region, values_from = n, values_fill = 0L) %>% 
  tidyr::complete(date = seq.Date(from = min(date), to = max(date), by = "day")) %>% 
  tidyr::pivot_longer(cols = -date, names_to = "region", values_to = "n") %>% 
  tidyr::replace_na(replace = list(n = 0L)) %>% 
  dplyr::group_by(region) %>% 
  tidyr::nest() %>% 
  dplyr::mutate(diff = purrr::map(data, ~ lagdiff(.$n)),
                cum = purrr::map(data, ~ cumsum(.$n)),
                ma7 = purrr::map(data, ~ ma7(.$n))) %>% 
  tidyr::unnest() %>% 
  dplyr::left_join(prefs %>% dplyr::distinct(`八地方区分`), .,
                   by = c("八地方区分" = "region")) %>% 
  dplyr::mutate(region = forcats::fct_inorder(`八地方区分`)) %>% 
  dplyr::select(date, region, n, diff, cum, ma7) %>% 
  dplyr::arrange(date)
x_by_region

 

都道府県別日次集計

陽性者数、前日差、累計、移動平均。

x_by_prefs <- x %>% 
  dplyr::filter(!is.na(Pref)) %>% 
  dplyr::group_by(date, Pref) %>% 
  dplyr::summarise(n = n()) %>% 
  dplyr::ungroup() %>% 
  tidyr::pivot_wider(names_from = Pref, values_from = n, values_fill = 0L) %>% 
  tidyr::complete(date = seq.Date(from = min(date), to = max(date), by = "day")) %>% 
  tidyr::pivot_longer(cols = -date, names_to = "Pref", values_to = "n") %>% 
  tidyr::replace_na(replace = list(n = 0L)) %>% 
  dplyr::group_by(Pref) %>% 
  tidyr::nest() %>% 
  dplyr::mutate(diff = purrr::map(data, ~ lagdiff(.$n)),
                cum = purrr::map(data, ~ cumsum(.$n)),
                ma7 = purrr::map(data, ~ ma7(.$n))) %>% 
  tidyr::unnest() %>% 
  dplyr::left_join(prefs, ., by = c("都道府県" = "Pref")) %>% 
  dplyr::mutate(Pref = forcats::fct_inorder(`都道府県`)) %>% 
  dplyr::select(date, Pref, n, diff, cum, ma7) %>% 
  dplyr::arrange(date)
x_by_prefs

 

日次集計(死亡者)

地域別

都道府県別

start <- df_s$prefectures %>% 
  dplyr::select(pref = name, date = dailyDeceasedStartDate) %>% 
  dplyr::left_join(prefs, by = c("pref" = "pref")) %>% 
  dplyr::arrange(pcode) %>% 
  tidyr::drop_na(pcode) %>% 
  dplyr::select(date, Pref = `都道府県`) %>% 
  dplyr::distinct(date) %>% 
  .$date %>% lubridate::as_date()

d_by_prefs <- df_s$prefectures %>% 
  dplyr::select(deceased = dailyDeceasedCount, pref = name) %>% 
  dplyr::left_join(prefs, by = c("pref" = "pref")) %>% 
  tidyr::drop_na(pcode) %>% 
  dplyr::select(Pref = `都道府県`, deceased) %>% 
  tidyr::unnest(deceased) %>% 
  tidyr::pivot_wider(names_from = Pref, values_from = deceased) %>% 
  tidyr::unnest() %>% 
  dplyr::mutate(date = seq.Date(from = start, to = start + nrow(.) - 1,
                                by = "day")) %>% 
  dplyr::select(date, dplyr::everything()) %>% 
  tidyr::pivot_longer(col = -date, names_to = "Pref", values_to = "n") %>% 
  dplyr::group_by(Pref) %>% 
  tidyr::nest() %>% 
  dplyr::mutate(diff = purrr::map(data, ~ lagdiff(.$n)),
                cum = purrr::map(data, ~ cumsum(.$n)),
                ma7 = purrr::map(data, ~ ma7(.$n))) %>% 
  tidyr::unnest() %>% 
  dplyr::left_join(prefs, ., by = c("都道府県" = "Pref")) %>% 
  dplyr::mutate(Pref = forcats::fct_inorder(`都道府県`)) %>% 
  dplyr::select(date, Pref, n, diff, cum, ma7) %>% 
  dplyr::arrange(date)
d_by_prefs

Visualize

全国の日次推移

sec_scale <- 100
datetime <- lubridate::as_datetime(df_s$updated, tz = "Japan")

x_by_all %>% 
  ggplot2::ggplot(ggplot2::aes(x = date)) + 
    ggplot2::geom_bar(ggplot2::aes(y = n), stat = "identity", width = 1.0,
                      alpha = 0.5) + 
    ggplot2::geom_line(ggplot2::aes(y = ma7), linetype = "dotted", size = 0.5) + 
    ggplot2::geom_line(ggplot2::aes(y = cum / sec_scale), colour = "dark green") +
    ggplot2::labs(title = paste0("@", datetime), caption = caption,
                  x = "", y = "") +
    ggplot2::scale_y_continuous(
      name = "陽性者数(単日)・移動平均(点線)",
      sec.axis = ggplot2::sec_axis(~ . * sec_scale,
                                    name = "累積陽性者数(折線)")
    )

x_by_all %>% 
  ggplot2::ggplot(ggplot2::aes(x = date)) + 
    ggplot2::geom_line(ggplot2::aes(y = diff), colour = "dark green", alpha = 0.5) + 
    ggplot2::labs(title = paste0("@", datetime), caption = caption, 
                  x = "", y = "陽性者数前日差")

 

地方別の日次推移

陽性者数(単日)

x_by_region %>% 
  ggplot2::ggplot(ggplot2::aes(x = date, y = n)) + 
    ggplot2::geom_bar(ggplot2::aes(y = n, fill = region), stat = "identity",
                      width = 1.0, alpha = 0.5) + 
    ggplot2::labs(title = paste0("単日 @", datetime), caption = caption, 
                  x = "", y = "陽性者数[人]") 

 

陽性者数(単日)の移動平均

x_by_region %>% 
  ggplot2::ggplot(ggplot2::aes(x = date, y = ma7, colour = region)) + 
    ggplot2::geom_line(size = 1) +
    ggplot2::theme(legend.position = 'none') +
    ggplot2::labs(title = paste0("7日間移動平均 @", datetime), caption = caption,
                  x = "", y = "陽性者数[人]") + 
    ggrepel::geom_text_repel(ggplot2::aes(label = region),
                             data = subset(x_by_region, date == max(date)),
                             nudge_x = 30, segment.alpha = 0.5, size = 3) + 
    ggplot2::lims(x = c(min(x_by_region$date),
                        max(x_by_region$date) + 45))

 

陽性者数(累積)

x_by_region %>% 
  ggplot2::ggplot(ggplot2::aes(x = date, y = cum, colour = region)) + 
    ggplot2::geom_line() +
    ggplot2::theme(legend.position = 'none') + 
    ggplot2::labs(title = paste0("累積陽性者数@", datetime), caption = caption,
                  x = "", y = "累積[人]") + 
    ggrepel::geom_text_repel(ggplot2::aes(label = region),
                             data = subset(x_by_region, date == max(date)))

 

陽性者数(単日)+累積陽性者数

sec_scale <- 50
datetime <- lubridate::as_datetime(df_s$updated, tz = "Japan")

x_by_region %>% 
  ggplot2::ggplot(ggplot2::aes(x = date)) + 
    ggplot2::geom_bar(ggplot2::aes(y = n, fill = region), stat = "identity",
                      alpha = 0.5, width = 1.0) + 
    ggplot2::geom_line(ggplot2::aes(y = cum / sec_scale, colour = region)) +
    ggplot2::facet_wrap(~ region) + 
    ggplot2::theme(legend.position = 'none') + 
    ggplot2::labs(title = paste0("Fixed scale @", datetime), caption = caption,
                  x = "", y = "") + 
    ggplot2::scale_y_continuous(
      name = "陽性者数(単日)",
      sec.axis = ggplot2::sec_axis(~ . * sec_scale,
                                    name = "累積陽性者数(折線)")
    )

x_by_region %>% 
  ggplot2::ggplot(ggplot2::aes(x = date)) + 
    ggplot2::geom_bar(ggplot2::aes(y = n, fill = region), stat = "identity",
                      alpha = 0.5, width = 1.0) + 
    ggplot2::geom_line(ggplot2::aes(y = ma7, colour = region),
                       linetype = "solid", size = 0.25) + 
    ggplot2::geom_line(ggplot2::aes(y = cum / sec_scale, colour = region)) +
    ggplot2::facet_wrap(~ region, scales = "free_y") + 
    ggplot2::theme(legend.position = 'none') + 
    ggplot2::labs(title = paste0("Free Y scale @", datetime), caption = caption,
                  x = "", y = "") + 
    ggplot2::scale_y_continuous(
      name = "陽性者数(単日)",
      sec.axis = ggplot2::sec_axis(~ . * sec_scale,
                                    name = "累積陽性者数(折線)")
    )

陽性者数(前日差)

x_by_region %>% 
  ggplot2::ggplot(ggplot2::aes(x = date)) + 
    ggplot2::geom_line(ggplot2::aes(y = diff, colour = region)) +
    ggplot2::facet_wrap(~ region, scales = "free_y") + 
    ggplot2::theme(legend.position = 'none') + 
    ggplot2::labs(title = paste0("陽性者数前日差, Free Y scale @", datetime),
                  caption = caption, x = "", y = "")

 

都道府県別日次推移

sec_scale <- 100
ncol <- 5
datetime <- lubridate::as_datetime(df_s$updated, tz = "Japan")


x_by_prefs %>% 
  ggplot2::ggplot(ggplot2::aes(x = date)) + 
    ggplot2::geom_bar(ggplot2::aes(y = n, fill = Pref), stat = "identity",
                      alpha = 0.25, width = 1.0) + 
    ggplot2::geom_line(ggplot2::aes(y = ma7, colour = Pref),
                       linetype = "solid", size = 0.25) + 
    ggplot2::geom_line(ggplot2::aes(y = cum / sec_scale, colour = Pref)) +
    ggplot2::facet_wrap(~ Pref, ncol = ncol) + 
    ggplot2::theme(legend.position = 'none') + 
    ggplot2::labs(title = paste0("Fixed scale @", datetime), caption = caption,
                  x = "", y = "") + 
    ggplot2::scale_y_continuous(
      name = "陽性者数(単日)",
      sec.axis = ggplot2::sec_axis(~ . * sec_scale,
                                    name = "累積陽性者数(折線)")
    )

x_by_prefs %>% 
  ggplot2::ggplot(ggplot2::aes(x = date)) + 
  ggplot2::geom_bar(ggplot2::aes(y = n, fill = Pref), stat = "identity",
                      alpha = 0.35, width = 1.0) + 
    ggplot2::geom_line(ggplot2::aes(y = ma7, colour = Pref),
                       linetype = "solid", size = 0.25) + 
    ggplot2::geom_line(ggplot2::aes(y = cum / sec_scale, colour = Pref)) +
    ggplot2::facet_wrap(~ Pref, ncol = ncol, scales = "free_y") + 
    ggplot2::theme(legend.position = 'none') + 
    ggplot2::labs(title = paste0("Free Y scale @", datetime), caption = caption,
                  x = "", y = "") + 
    ggplot2::scale_y_continuous(
      name = "陽性者数(単日)",
      sec.axis = ggplot2::sec_axis(~ . * sec_scale,
                                    name = "累積陽性者数(折線)")
    )

x_by_prefs %>% 
  ggplot2::ggplot(ggplot2::aes(x = date)) + 
    ggplot2::geom_line(ggplot2::aes(y = diff, colour = Pref)) +
    ggplot2::facet_wrap(~ Pref, ncol = ncol, scales = "free_y") + 
    ggplot2::theme(legend.position = 'none') + 
    ggplot2::labs(title = paste0("陽性者数前日差, Free Y scale @", datetime),
                  x = "", y = "")

 

都道府県別日次推移(死亡者数)

sec_scale <- 10
ncol <- 5
datetime <- lubridate::as_datetime(df_s$updated, tz = "Japan")


d_by_prefs %>% 
  ggplot2::ggplot(ggplot2::aes(x = date)) + 
    ggplot2::geom_bar(ggplot2::aes(y = n, fill = Pref), stat = "identity",
                      alpha = 0.25, width = 1.0) + 
    ggplot2::geom_line(ggplot2::aes(y = ma7, colour = Pref),
                       linetype = "solid", size = 0.25) + 
    ggplot2::geom_line(ggplot2::aes(y = cum / sec_scale, colour = Pref)) +
    ggplot2::facet_wrap(~ Pref, ncol = ncol) + 
    ggplot2::theme(legend.position = 'none') + 
    ggplot2::labs(title = paste0("Fixed scale @", datetime), caption = caption,
                  x = "", y = "") + 
    ggplot2::scale_y_continuous(
      name = "死亡者数(単日)",
      sec.axis = ggplot2::sec_axis(~ . * sec_scale,
                                    name = "累積死亡者数(折線)")
    )

d_by_prefs %>% 
  ggplot2::ggplot(ggplot2::aes(x = date)) + 
  ggplot2::geom_bar(ggplot2::aes(y = n, fill = Pref), stat = "identity",
                      alpha = 0.35, width = 1.0) + 
    ggplot2::geom_line(ggplot2::aes(y = ma7, colour = Pref),
                       linetype = "solid", size = 0.25) + 
    ggplot2::geom_line(ggplot2::aes(y = cum / sec_scale, colour = Pref)) +
    ggplot2::facet_wrap(~ Pref, ncol = ncol, scales = "free_y") + 
    ggplot2::theme(legend.position = 'none') + 
    ggplot2::labs(title = paste0("Free Y scale @", datetime), caption = caption,
                  x = "", y = "") + 
    ggplot2::scale_y_continuous(
      name = "死亡者数(単日)",
      sec.axis = ggplot2::sec_axis(~ . * sec_scale,
                                    name = "累積死亡者数(折線)")
    )

都道府県別

x %>% 
  dplyr::group_by(Pref) %>% 
  dplyr::summarise(n = n()) %>% 
  dplyr::left_join(prefs, by = c("Pref" = "都道府県")) %>% 
  dplyr::select(Pref, n, population = `推計人口`) %>% 
  dplyr::mutate(rate = round(n / population, 2)) %>% 
  ggplot2::ggplot(ggplot2::aes(x = population, y = n) ) + 
    ggplot2::geom_point(ggplot2::aes(colour = Pref)) + 
    ggrepel::geom_text_repel(ggplot2::aes(label = Pref, colour = Pref)) + 
    ggplot2::theme(legend.position = 'none') + 
    ggplot2::labs(title = "", caption = caption,
                  x = "推計人口[千人]", y = "累計陽性者数")

x %>% 
  dplyr::group_by(Pref) %>% 
  dplyr::summarise(n = n()) %>% 
  dplyr::left_join(prefs, by = c("Pref" = "都道府県")) %>% 
  dplyr::select(Pref, n, population = `推計人口`) %>% 
  dplyr::mutate(rate = round(n / population, 2)) %>% 
  dplyr::filter(n < 5000) %>% 
  # dplyr::slice_min(order_by = n, n = 38) %>% 
  ggplot2::ggplot(ggplot2::aes(x = population, y = n) ) + 
    ggplot2::geom_point(ggplot2::aes(colour = Pref)) + 
    ggrepel::geom_text_repel(ggplot2::aes(label = Pref, colour = Pref)) + 
    ggplot2::theme(legend.position = 'none') + 
    ggplot2::labs(title = "累計陽性者数千人未満", caption = caption,
                  x = "推計人口[五千人]", y = "累計陽性者数")

地方区分別

region <- prefs %>% 
  dplyr::group_by(`八地方区分`) %>% 
  dplyr::summarise(population = sum(`推計人口`)) %>% 
  dplyr::rename(region = `八地方区分`)

x %>% 
  dplyr::group_by(region) %>% 
  dplyr::summarise(n = n()) %>% 
  dplyr::left_join(region, by = c("region" = "region")) %>% 
  dplyr::select(region, n, population) %>% 
  dplyr::mutate(rate = round(n / population, 2)) %>% 
  ggplot2::ggplot(ggplot2::aes(x = population, y = n) ) + 
    ggplot2::geom_point(ggplot2::aes(colour = region)) + 
    ggrepel::geom_text_repel(ggplot2::aes(label = region, colour = region)) + 
    ggplot2::theme(legend.position = 'none') + 
    ggplot2::labs(title = "", caption = caption,
                  x = "推計人口[千人]", y = "累計陽性者数")